home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / mobile / fma-2.0-stable-setup.exe / {app} / source / uAddToGroup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-07  |  3.7 KB  |  138 lines
  1. unit uAddToGroup;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, TntStdCtrls, CheckLst, TntCheckLst, uSyncPhonebook,
  8.   ExtCtrls, jpeg;
  9.  
  10. type
  11.   TfrmAddToGroup = class(TForm)
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     Panel1: TPanel;
  15.     Label1: TLabel;
  16.     RadioButton1: TRadioButton;
  17.     RadioButton2: TRadioButton;
  18.     lblName: TTntLabel;
  19.     Label2: TLabel;
  20.     lblGroup: TTntLabel;
  21.     clNumbers: TTntCheckListBox;
  22.     Bevel1: TBevel;
  23.     Image1: TImage;
  24.     Label3: TLabel;
  25.     lbProductName: TLabel;
  26.     lblNumber: TLabel;
  27.     RadioButton3: TRadioButton;
  28.     Button3: TButton;
  29.     procedure RadioButtonClick(Sender: TObject);
  30.     procedure Button1Click(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.   private
  33.     FContact: PContactData;
  34.     procedure Set_Contact(const Value: PContactData);
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.     function CheckedCount: integer;
  39.     function GetNumber(Index: integer): string;
  40.     property Contact: PContactData read FContact write Set_Contact;
  41.   end;
  42.  
  43. var
  44.   frmAddToGroup: TfrmAddToGroup;
  45.  
  46. implementation
  47.  
  48. uses Unit1;
  49.  
  50. {$R *.dfm}
  51.  
  52. procedure TfrmAddToGroup.RadioButtonClick(Sender: TObject);
  53. begin
  54.   clNumbers.Enabled := RadioButton2.Checked;
  55.   if clNumbers.Enabled then clNumbers.Color := clWindow
  56.     else clNumbers.Color := clBtnFace;
  57. end;
  58.  
  59. procedure TfrmAddToGroup.Set_Contact(const Value: PContactData);
  60. var
  61.   i: integer;
  62. begin
  63.   FContact := Value;
  64.   { Build contact numbers check list }
  65.   clNumbers.Items.Clear;
  66.   lblName.Caption := GetContactFullName(FContact);
  67.   if FContact^.cell <> '' then clNumbers.Items.Add('Cell ['+FContact^.cell+']');
  68.   if FContact^.work <> '' then clNumbers.Items.Add('Work ['+FContact^.work+']');
  69.   if FContact^.home <> '' then clNumbers.Items.Add('Home ['+FContact^.home+']');
  70.   if FContact^.other <> '' then clNumbers.Items.Add('Other ['+FContact^.other+']');
  71.   if clNumbers.Count = 0 then
  72.     raise Exception.Create('This contact does not have any phone number');
  73.   { Find default number }
  74.   lblNumber.Caption := GetContactDefPhone(FContact);
  75.   for i := 0 to clNumbers.Count-1 do
  76.     if GetNumber(i) = lblNumber.Caption then begin
  77.       lblNumber.Caption := clNumbers.Items[i];
  78.       break;
  79.     end;
  80.   { Update view }  
  81.   RadioButton1.Checked := True;
  82.   RadioButtonClick(nil);
  83. end;
  84.  
  85. procedure TfrmAddToGroup.Button1Click(Sender: TObject);
  86. var
  87.   i: integer;
  88. begin
  89.   if RadioButton3.Checked then begin
  90.     for i := 0 to clNumbers.Count-1 do clNumbers.Checked[i] := True;
  91.     RadioButton2.Checked := True;
  92.   end;
  93.   if CheckedCount = 0 then
  94.     raise Exception.Create('You have to select at least one phone number');
  95.   ModalResult := mrOk;  
  96. end;
  97.  
  98. function TfrmAddToGroup.CheckedCount: integer;
  99. var
  100.   i: integer;
  101. begin
  102.   if RadioButton2.Checked then begin
  103.     Result := 0;
  104.     for i := 0 to clNumbers.Count-1 do
  105.       if clNumbers.Checked[i] then Result := Result + 1;
  106.   end
  107.   else
  108.     Result := 1;
  109. end;
  110.  
  111. procedure TfrmAddToGroup.FormCreate(Sender: TObject);
  112. begin
  113. {$IFNDEF VER150}
  114.   Form1.ThemeManager1.CollectForms(Self);
  115. {$ENDIF}
  116.   Image1.Picture.Assign(Form1.FmaWebUpdate1.Picture);
  117.   lblName.Font.Style := lblName.Font.Style + [fsBold];
  118. end;
  119.  
  120. function TfrmAddToGroup.GetNumber(Index: integer): string;
  121. var
  122.   s: string;
  123.   i: integer;
  124. begin
  125.   if (Index >= 0) and (Index < clNumbers.Count) then begin
  126.     { s is like 'Name [+number]' }
  127.     s := clNumbers.Items[Index];
  128.     i := Pos('[',s);
  129.     Delete(s,1,i); // remove 'Name ['
  130.     Delete(s,Length(s),1); // remove ']'
  131.     Result := s;
  132.   end
  133.   else
  134.     Result := '';  
  135. end;
  136.  
  137. end.
  138.